home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Amiga-E / E_v3.2a_extras / PdSrc / Lang / NGRC.e
Text File  |  1992-09-02  |  22KB  |  743 lines
  1. /* Noise Compiler v1.0
  2.  
  3. Short:    The noise compiler is a program that translates source files in
  4.     a type of "music programming language" into Noise/ProTracker (tm)
  5.     compatible files.
  6.  
  7. The noise compiler reads ascii source files containing a description
  8. of a musical piece, and then starts generating a sequence of notes by
  9. recursively walking down your definition. finally, it will load all
  10. samples and write all data to a ProTracker (tm) file.
  11.  
  12. A noise grammar program (extension ".ngr") consist of one to unlimited
  13. number of so called "rules" (it really helps if you already know something
  14. about context free grammars). Each rule looks like:
  15.  
  16. <sym> "->" <symlist> ";"
  17.  
  18. example:
  19.  
  20. beat -> drum [C#,1]                     /* a C-flat */
  21.         { [D,2] | [D#,2] | [Db,2] }     /* D, D-sharp, D-flat */
  22.         ( boomboom 1 );                 /* index=1 */
  23.  
  24. every token may be separated by a whitespace, which denotes any number of
  25. spaces/tabs/linefeeds, and comments which start with "/*" and end
  26. with "*/", and may be nested infinitely.
  27.  
  28. a <symlist> is one or more <item>s. an <item> can be:
  29.  
  30.     <sym> <index>
  31.  
  32. will be recursively replaced by the definition of <sym>.
  33. <index> is optional and explained later
  34. example: drum
  35.  
  36.     "(" <weight> <symlist> ")"
  37.  
  38. as <sym>, only an optional <weight> (default=500, range 0-1000) specifies
  39. the chance of <symlist> getting rewritten, with 0=no chance at all.
  40. example:
  41.  
  42. (beat)        (250 beat)
  43.  
  44. decide while generating if the defintion for "beat" gets played or
  45. not, resp. 50% and 25% chance.
  46.  
  47.     "{" <weight> <symlist> "|" ..... "}"
  48.  
  49. any number of <symlist>s may be between the {}, separated by a bar |.
  50. <weight> is again optional, and again between 0-1000, only now
  51. the default =1. With no weights, simply one of the <simlist>s is
  52. picked. examples:
  53.  
  54. { beat | boomboom | [Gb+,4] }        /* chances: each 33% */
  55. { 3 beat | 7 boomboom }            /* chances: 30%,70% resp. */
  56.  
  57.     <samplename> <vol>
  58.  
  59. an AmigaDos path to a sample, <vol> is an optional integer, range 0-64
  60. example: "samples:guitar.iff"
  61.  
  62.     "[" <note> "," <duration> "]"
  63.  
  64. a note specification, see below.
  65.  
  66.     <hexinteger>
  67.  
  68. a special effects spec., see below.
  69.  
  70. Notes.
  71. a <note> is a character like:  C D E F G A B
  72. it may be followed by any number of modifiers, where:
  73.  
  74. "#" = sharp
  75. "b" = flat
  76. "+" = octave up
  77. "-" = octave down
  78.  
  79. in general, you can get only one octave up/down, and the parser will
  80. give an error if you write something like "E+++"
  81. Any number of "#" and "b" are allowed, only in general you would
  82. write "D" for "C##", or "F" for "E#" etc. Note that the current
  83. version of the noise compiler only allows for C-major. Examples:
  84.  
  85. C    C (the one in the middle of a piano)
  86. C#+    C-sharp one octave up
  87. Dbb-    C one octave down
  88.  
  89. for those who are not at all familiar with classical notes, a note
  90. may also be specified as an integer ranging from -12 to 23, with
  91. 0 being the middle C again, and negative numbers lower notes.
  92.  
  93. the <duration> is an integer specifying the time in units spent
  94. on playing the note, before starting the new one, range = 1-100
  95. A unit is about a quarter of a normal note, so a whole note should
  96. be written "4" etc. examples:
  97.  
  98. [C,1]
  99. [F#,4]         /* an F-sharp for one second */
  100.  
  101.  
  102. Sound Effects.
  103. various souneffects may be used as an hexadecimal integer.
  104. Such an effect only works with the next following note.
  105. Example:
  106.  
  107. mainpart -> $E01 drums solo drums
  108.  
  109. puts hardware audio filter off before play. See protracker documentation
  110. for a summary of effects.
  111.  
  112. Indexing.
  113. while () and {|||} are nice ways to either generate totally random music, or
  114. just make your pieces sound more natural due to some variation, one often
  115. wishes to have the random choices made repeated: for example, if
  116. you design a symbol "beat" that you wish to re-use in certain parts of
  117. your program, and the definition contains some random-variation, you
  118. may want to have the random choices fixed for the second time you use it,
  119. because it would sound totally random otherwise. for example, considering
  120. the pseudo-definition of "beat" above:
  121.  
  122. beats -> beat boomboom beat boomboom;
  123.  
  124. this looks like a normal rhytm, but "beat" is replaced by two different
  125. sequences of notes. with:
  126.  
  127. beats -> beat1 boomboom2 beat1 boomboom2;
  128.  
  129. you specify that with the first "beat", the random choices are recorded
  130. and all others that are similar indexed will have their notes generated
  131. according to the first. note that this doesn't work for samples, i.e:
  132.  
  133. beats -> "bass.iff" beat1 "hihat.iff" beat1;
  134.  
  135. will generate two exactly the same sequences, only played by different
  136. instruments.
  137.  
  138.  
  139. Symbols and Channels.
  140. A symbol consists of any number of lowercase characters. As the
  141. Amiga plays four channels simulanously, there's not one start
  142. symbol for the grammar, but four, called: "one", "two", "three",
  143. "four". Atleast one of these has to be defined in a grammar.
  144. Example:
  145.  
  146. one -> "dat:noiz/Dguitar" 20 aa1;
  147. two -> "dat:noiz/drumz/bassdrum" aa1;
  148.  
  149. aa -> a $E00 a $E01 a a;
  150.  
  151. a -> { c d c c d d | d d | c d c d | c c };
  152.  
  153. c -> [C,1] [C#,3];
  154. d -> [D,2] [D,3];
  155.  
  156. plays the sequence "aa" simultanously over two channels, by two
  157. different instruments, with volumes 20 and 64. the sequence "aa"
  158. consists of several instances of "a", while switching filter
  159. on/off. "a" consist of 4 possible sequences, which in turn
  160. consist of notes to be played. (NOTE: don't try these examples,
  161. they no pieces of real music, just "examples")
  162.  
  163.  
  164. Designing Tunes.
  165. For example, for a small guitar tune, we would start with
  166. a defintion of some notes, a and b
  167.  
  168. a -> [D,1] [E,3];
  169. b -> [D,1] [D#,7];
  170.  
  171. Then, we would combine them into a sequence:
  172.  
  173. c -> a a a b;
  174.  
  175. Finally, we play those over channel one, and define a sample:
  176.  
  177. one -> guitar c c c a [C,16];          /* just one channel */
  178.  
  179. /* our set of instruments */
  180. guitar -> "dat:noiz/Dguitar";
  181.  
  182. note that notes get played by a certain instrument from the point it
  183. is encountered in the grammar.
  184.  
  185.  
  186. Using Randomness.
  187. You may use randomness to bring subtle variations into your music,
  188. for example, with:
  189.  
  190. mynote -> { 10 [D,2] | 1 [D#,2] | 1 [Db,2] };
  191.  
  192. we define a note that is played like a "D" most of the time, but
  193. occasionally flat or sharp. We can easily do the same thing with
  194. the duration, or even with the order a certain sequence gets played.
  195.  
  196. */
  197.  
  198. OBJECT sym            /* primairy structure of rewrite symbols */
  199.   next,type,name,rptr
  200. ENDOBJECT
  201.  
  202. OBJECT rlist            /* linked list structure for grammar     */
  203.   next,type,index,info
  204. ENDOBJECT
  205.  
  206. OBJECT optset            /* structure for storing { | | } exp.    */
  207.   next,rptr,weight
  208. ENDOBJECT
  209.  
  210. OBJECT sample            /* all data about a given sample         */
  211.   path,len,adr,vol
  212. ENDOBJECT
  213.  
  214. OBJECT i            /* indexing of rewritten trees           */
  215.   start,len,isym
  216. ENDOBJECT
  217.  
  218. ENUM SYM,OPTSET,OPTION,NOTE,SAMPLE,SFX        /* rlist.type    */
  219. ENUM NOTYPE,REWRITE                /* sym.type    */
  220. ENUM NOMEM,NOFILE,NOFORM,NOGRAM,STACKFLOW,    /* errors    */
  221.      BADSTRUCTURE,BREAK,WRITEMOD,READSAMPLE
  222.  
  223. CONST MAXINDEX=1000,MAXROWS=64*4*64,MAXDURATION=100
  224. CONST MAXDATA=MAXROWS*4,MAXSAMPLE=31,MAXNOTE=23,MINNOTE=-12
  225. CONST PARSE_ER=100,GEN_ER=200,MASK=$0FFF0FFF
  226.  
  227. RAISE NOMEM IF New()=NIL,            /* define exceptions */
  228.       NOMEM IF String()=NIL,
  229.       STACKFLOW IF FreeStack()<1000,
  230.       BREAK IF CtrlC()=TRUE
  231.  
  232. DEF buf,flen,p,tokeninfo,symlist=NIL:PTR TO sym,ltoken=-1,numsample=0,
  233.     notes,np:PTR TO LONG,maxrows=0,cursample=0,cursfx=0,curglob=0,end,
  234.     timings:PTR TO INT,fh=NIL,notevals:PTR TO LONG
  235.  
  236. DEF sdata[32]:ARRAY OF sample,
  237.     itab[MAXINDEX]:ARRAY OF i,
  238.     channel[4]:ARRAY OF i,
  239.     infile[100]:STRING,outfile[100]:STRING
  240.  
  241. PROC main() HANDLE
  242.   WriteF('Noise Compiler v1.0\n')
  243.   WriteF('Translates NoiseGrammar programs into ProTracker modules!\n')
  244.   readgrammar()
  245.   WriteF('grammar "\s" loaded. Parsing...\n',infile)
  246.   parsegrammar()
  247.   WriteF('Grammar parsed succesfully. Generating...\n')
  248.   generate()
  249.   WriteF('Noise generated. Now loading samples...\n')
  250.   loadsamples()
  251.   WriteF('Now saving to file "\s".\n',outfile)
  252.   writemodule()
  253.   WriteF('done.\n')
  254. EXCEPT
  255.   IF fh THEN Close(fh)           /* lowest level exception handler: */
  256.   WriteF('Terminating: ')        /* general error report */
  257.   SELECT exception
  258.     CASE NOFILE;       WriteF('Could not load "\s" grammar file!\n',infile)
  259.     CASE NOMEM;        WriteF('Not enough memory!\n')
  260.     CASE NOFORM;       WriteF('Grammar format error!\n')
  261.     CASE STACKFLOW;    WriteF('Stack overflow! (too heavy recursion?)\n')
  262.     CASE BADSTRUCTURE; WriteF('Problems while generating.\n')
  263.     CASE NOGRAM;       WriteF('No rules rewritten!\n')
  264.     CASE BREAK;        WriteF('Stopped by user\n')
  265.     CASE WRITEMOD;     WriteF('Unable to write PT module "\s"!\n',outfile)
  266.     CASE READSAMPLE;   WriteF('Unable to read sample(s)!\n')
  267.   ENDSELECT
  268.   DeleteFile(outfile)
  269. ENDPROC
  270.  
  271. PROC readgrammar()
  272.   StrCopy(infile,arg,ALL)
  273.   StrAdd(infile,'.ngr',ALL)    /* '#?.ngr' = NoizGRammar */
  274.   StrCopy(outfile,arg,ALL)    /* '#?.mod' = ProTracker format */
  275.   StrAdd(outfile,'.mod',ALL)
  276.   IF (flen:=FileLength(infile))<1 THEN Raise(NOFILE)
  277.   IF (fh:=Open(infile,OLDFILE))=NIL THEN Raise(NOFILE)
  278.   IF Read(fh,buf:=New(flen+1),flen)<>flen THEN Raise(NOFILE)
  279.   Close(fh)
  280.   fh:=NIL
  281.   buf[flen]:=";"        /* for parser */
  282. ENDPROC
  283.  
  284. /* this is the parser part. we use a simple but powerfull top-down
  285.    parser, and build our syntax tree here.                              */
  286.  
  287. ENUM ER_UNTOKEN=PARSE_ER,ER_UNEXPECTED,ER_QUOTE,ER_SYMEXP,ER_DOUBLE,
  288.      ER_ARROWEXP,ER_RPARENTHEXP,ER_RBRACEEXP,ER_EMPTY,ER_EOLEXP,ER_RANGE,
  289.      ER_COMMENT,ER_UNDEF,ER_RBRACKETEXP,ER_MAXSAMPLE,ER_NOSAMPLE,
  290.      ER_INTEGEREXP,ER_COMMAEXP,ER_NOTEEXP
  291.  
  292. ENUM EOF,EOL,ARROW,BAR,COMMA,        /* ; -> | ,    */
  293.      RSYM,INTEGER,HEXINTEGER,        /* sym 100 $E01    */
  294.      ISTRING,NOTEVAL,            /* "" C#+    */
  295.      LBRACE,RBRACE,LPARENTH,        /* { } (    */
  296.      RPARENTH,LBRACKET,RBRACKET        /* ) [ ]    */
  297.  
  298. PROC parsegrammar() HANDLE
  299.   DEF end,spot,sl:PTR TO sym,s,i
  300.   notevals:=[9,11,0,2,4,5,7]
  301.   p:=buf
  302.   WHILE parserule() DO NOP
  303.   p:=NIL
  304.   IF (sl:=symlist)=NIL THEN Raise(NOGRAM)
  305.   IF numsample=0 THEN Raise(ER_NOSAMPLE)
  306.   REPEAT
  307.     IF sl.type=NOTYPE            /* check for undefined symbols */
  308.       s:=sl.name
  309.       Raise(ER_UNDEF)
  310.     ENDIF
  311.   UNTIL (sl:=sl.next)=NIL
  312. EXCEPT                         /* re-throw if unknown exception */
  313.   IF exception>=PARSE_ER THEN WriteF('ERROR: ') ELSE Raise(exception)
  314.   WriteF(ListItem(['Unexpected lexical item\n',
  315.     'Unexpected characters in line!\n',
  316.     'Unmatched quote "\n',
  317.     'Symbol expected\n',
  318.     'Double definition of symbol\n',           /* language errors */
  319.     '"->" expected\n',
  320.     '")" expected\n',
  321.     '"}" expected\n',
  322.     'Empty rewrite-list\n',
  323.     'End of rule expected\n',
  324.     'Integer/Note value out of range\n',
  325.     'Incorrectly nested comment(s)\n',
  326.     'No rule defined for symbol "\s"\n',
  327.     '"]" expected\n',
  328.     'Maximum of 32 samples exceeded\n',
  329.     'Grammar needs atleast one sample\n',
  330.     'Integer expected\n',
  331.     '"," expected\n',
  332.     'Note expected'],exception-PARSE_ER),s)
  333.   IF p                /* display very nice error indication */
  334.     IF p[-1]=";" THEN DEC p
  335.     spot:=p
  336.     WHILE (p[]--<>";") AND (p[]<>10) AND (p<>buf) DO NOP
  337.     INC p
  338.     spot:=spot-p+5
  339.     end:=p
  340.     WHILE (end[]<>";") AND (end[]++<>10) DO NOP
  341.     end[]--:=0
  342.     WriteF('LINE: \s\n',p)
  343.     FOR i:=1 TO spot DO WriteF(' ')
  344.     WriteF('^\n')
  345.   ENDIF
  346.   Raise(NOFORM)
  347. ENDPROC
  348.  
  349. PROC parserule()
  350.   DEF token,csym:PTR TO sym
  351.   IF (token:=gettoken())=EOF
  352.     RETURN FALSE
  353.   ELSEIF token=RSYM
  354.     csym:=tokeninfo
  355.     IF csym.type<>NOTYPE THEN Raise(ER_DOUBLE)
  356.     IF gettoken()<>ARROW THEN Raise(ER_ARROWEXP)
  357.     csym.rptr:=parseitemlist()
  358.     csym.type:=REWRITE
  359.     IF gettoken()<>EOL THEN Raise(ER_EOLEXP)
  360.   ELSE
  361.     Raise(ER_SYMEXP)
  362.   ENDIF
  363. ENDPROC TRUE
  364.  
  365. PROC parseitemlist()
  366.   DEF item:PTR TO rlist,prev:PTR TO rlist,ilist=NIL
  367.   prev:={ilist}
  368.   WHILE (item:=parseitem())<>NIL
  369.     prev.next:=item
  370.     prev:=item
  371.   ENDWHILE
  372.   IF ilist=NIL THEN Raise(ER_EMPTY)
  373. ENDPROC ilist
  374.  
  375. PROC parseitem()
  376.   DEF token,item:PTR TO rlist,t2,prev:PTR TO optset,
  377.       curr:PTR TO optset,olist,totalw=0
  378.   token:=gettoken()
  379.   IF token=RSYM
  380.     item:=New(SIZEOF rlist)
  381.     item.type:=SYM
  382.     item.info:=tokeninfo
  383.     IF (t2:=gettoken())=INTEGER
  384.       item.index:=checkinfo(1,MAXINDEX-1)
  385.     ELSE
  386.       putback(t2)
  387.       item.index:=0
  388.     ENDIF
  389.   ELSEIF token=ISTRING
  390.     item:=New(SIZEOF rlist)
  391.     item.type:=SAMPLE
  392.     sdata[numsample].path:=tokeninfo
  393.     IF (t2:=gettoken())=INTEGER
  394.       sdata[numsample].vol:=checkinfo(0,64)
  395.     ELSE
  396.       putback(t2)
  397.       sdata[numsample].vol:=64
  398.     ENDIF
  399.     item.info:=numsample++
  400.     IF numsample=MAXSAMPLE THEN Raise(ER_MAXSAMPLE)
  401.   ELSEIF token=LBRACE          /* parse { | | ... } */
  402.     item:=New(SIZEOF rlist)
  403.     item.type:=OPTSET
  404.     prev:={olist}
  405.     REPEAT
  406.       curr:=New(SIZEOF optset)
  407.       IF (token:=gettoken())=INTEGER        /* check for weight */
  408.         curr.weight:=checkinfo(0,1000)
  409.       ELSE
  410.         curr.weight:=1
  411.         putback(token)
  412.       ENDIF
  413.       totalw:=totalw+curr.weight
  414.       curr.rptr:=parseitemlist()
  415.       prev.next:=curr
  416.       prev:=curr
  417.     UNTIL (token:=gettoken())<>BAR
  418.     IF token<>RBRACE THEN Raise(ER_RBRACEEXP)
  419.     item.info:=olist
  420.     item.index:=totalw     /* we store weight here */
  421.   ELSEIF token=LPARENTH
  422.     item:=New(SIZEOF rlist)             /* parse ( ) */
  423.     item.type:=OPTION
  424.     IF (token:=gettoken())=INTEGER        /* check for weight */
  425.       item.index:=checkinfo(0,1000)
  426.     ELSE
  427.       item.index:=500
  428.       putback(token)
  429.     ENDIF
  430.     item.info:=parseitemlist()
  431.     IF gettoken()<>RPARENTH THEN Raise(ER_RPARENTHEXP)
  432.   ELSEIF token=LBRACKET
  433.     item:=New(SIZEOF rlist)             /* parse [note,duration] */
  434.     item.type:=NOTE
  435.     token:=gettoken()
  436.     IF (token<>INTEGER) AND (token<>NOTEVAL) THEN Raise(ER_NOTEEXP)
  437.     item.info:=checkinfo(MINNOTE,MAXNOTE)
  438.     IF gettoken()<>COMMA THEN Raise(ER_COMMAEXP)
  439.     IF gettoken()<>INTEGER THEN Raise(ER_INTEGEREXP)
  440.     item.index:=checkinfo(1,MAXDURATION)
  441.     IF gettoken()<>RBRACKET THEN Raise(ER_RBRACKETEXP)
  442.   ELSEIF token=HEXINTEGER
  443.     item:=New(SIZEOF rlist)             /* parse $SFX */
  444.     item.type:=SFX
  445.     item.info:=checkinfo(0,$FFF)
  446.   ELSEIF (token=EOL) OR (token=RBRACE) OR (token=RPARENTH) OR (token=BAR)
  447.     putback(token)
  448.     RETURN NIL
  449.   ELSE
  450.     Raise(ER_UNTOKEN)
  451.   ENDIF
  452. ENDPROC item
  453.  
  454. /* the lexical analyser: called by the parser each time it
  455.    needs a token. attribute values are in "tokeninfo". allows
  456.    for one symbol lookahead, with putback() function */
  457.  
  458. PROC gettoken()
  459.   DEF c,x,start,len,syml:PTR TO sym,s,depth
  460.   FreeStack(); CtrlC()
  461.   IF ltoken<>-1
  462.     x:=ltoken
  463.     ltoken:=-1
  464.     RETURN x
  465.   ENDIF
  466.   tokeninfo:=0
  467.   parse:
  468.   c:=p[]++
  469.   SELECT c
  470.     CASE ";"; RETURN IF buf+flen<p THEN p-- BUT EOF ELSE EOL
  471.     CASE "|"; RETURN BAR
  472.     CASE ","; RETURN COMMA
  473.     CASE "("; RETURN LPARENTH
  474.     CASE ")"; RETURN RPARENTH
  475.     CASE "{"; RETURN LBRACE
  476.     CASE "}"; RETURN RBRACE
  477.     CASE "["; RETURN LBRACKET
  478.     CASE "]"; RETURN RBRACKET
  479.     CASE "-"; IF p[]=">" THEN RETURN p++ BUT ARROW
  480.     CASE "/"
  481.       IF p[]="*"
  482.         x:=p
  483.         depth:=1
  484.         WHILE buf+flen>p++
  485.           IF (p[0]="/") AND (p[1]="*")
  486.             INC depth
  487.             INC p
  488.           ENDIF
  489.           IF (p[0]="*") AND (p[1]="/")
  490.             DEC depth
  491.             INC p
  492.           ENDIF
  493.           IF depth=0
  494.             INC p
  495.             BRA parse
  496.           ENDIF
  497.         ENDWHILE
  498.         p:=x
  499.         Raise(ER_COMMENT)
  500.       ENDIF
  501.       Raise(ER_UNEXPECTED)
  502.     CASE 34
  503.       start:=p
  504.       WHILE (p[]<>";") AND (p[]<>10) AND (p[]++<>34) DO NOP
  505.       IF p[-1]=";" THEN p-- BUT Raise(ER_QUOTE)
  506.       len:=p-start-1
  507.       tokeninfo:=String(len)
  508.       StrCopy(tokeninfo,start,len)
  509.       RETURN ISTRING
  510.     DEFAULT
  511.       IF (c>="a") AND (c<="z")
  512.         start:=p--
  513.         WHILE (p[]>="a") AND (p[]++<="z") DO NOP
  514.         len:=p---start
  515.         s:=String(len)
  516.         StrCopy(s,start,len)
  517.         syml:=symlist
  518.         WHILE syml
  519.           IF StrCmp(s,syml.name,ALL) THEN BRA found
  520.           syml:=syml.next
  521.         ENDWHILE
  522.         syml:=New(SIZEOF sym)
  523.         syml.next:=symlist
  524.         syml.name:=s
  525.         syml.type:=NOTYPE
  526.         symlist:=tokeninfo:=syml
  527.         RETURN RSYM
  528.         found:
  529.         tokeninfo:=syml
  530.         RETURN RSYM
  531.       ELSEIF (c>="A") AND (c<="G")
  532.         tokeninfo:=notevals[c-"A"]
  533.         LOOP
  534.           x:=p[]++
  535.           SELECT x
  536.             CASE "+"; tokeninfo:=tokeninfo+12        /* octave up    */
  537.             CASE "-"; tokeninfo:=tokeninfo-12        /* octave down    */
  538.             CASE "#"; tokeninfo:=tokeninfo+1        /* sharp    */
  539.             CASE "b"; tokeninfo:=tokeninfo-1        /* flat        */
  540.             DEFAULT
  541.               DEC p
  542.               RETURN NOTEVAL
  543.           ENDSELECT
  544.         ENDLOOP
  545.       ELSEIF ((c>="0") AND (c<="9")) OR (c="-") OR (c="$")
  546.         tokeninfo,x:=Val(p--)
  547.         p:=p+x
  548.         RETURN IF c="$" THEN HEXINTEGER ELSE INTEGER
  549.       ENDIF
  550.       IF c>32 THEN Raise(ER_UNEXPECTED) ELSE BRA parse
  551.   ENDSELECT
  552. ENDPROC
  553.  
  554. PROC putback(token)
  555.   ltoken:=token
  556. ENDPROC
  557.  
  558. PROC checkinfo(min,max) RETURN IF (tokeninfo<min) OR (tokeninfo>max) THEN
  559.   Raise(ER_RANGE) ELSE tokeninfo
  560.  
  561. ENUM NOCHANNEL=GEN_ER,LARGESONG,CROSSINDEX
  562.  
  563. PROC generate() HANDLE
  564.   DEF x,ci:PTR TO i,syms:PTR TO LONG,numc=0
  565.   Rnd(-Shl(VbeamPos(),14))        /* initialise seed */
  566.   ci:=itab
  567.   FOR x:=0 TO MAXINDEX-1 DO ci[].start++:=NIL
  568.   ci:=channel
  569.   timings:=[856,808,762,720,678,640,604,570,538,508,480,453,
  570.             428,404,381,360,339,320,302,285,269,254,240,226,
  571.             214,202,190,180,170,160,151,143,135,127,120,113]:INT
  572.   /*        C-  C#- D-  D#- E-  F-  F#- G-  G#- A-  A#- B-
  573.             C   C#  D   D#  E   F   F#  G   G#  A   A#  B
  574.             C+  C#+ D+  D#+ E+  F+  F#+ G+  G#+ A+  A#+ B+     */
  575.   WriteF('s\d\n',MAXDURATION*4+100+MAXDATA)
  576.   np:=notes:=New(MAXDURATION*4+100+MAXDATA)
  577.   end:=np+MAXDATA
  578.   syms:=['one','two','three','four']
  579.   FOR x:=0 TO 3
  580.     ci[x].start:=np
  581.     IF findsym(syms[x])
  582.       ci[x].len:=np-ci[x].start
  583.       IF ci[x].len>maxrows THEN maxrows:=ci[x].len
  584.       INC numc
  585.     ELSE
  586.       ci[x].start:=NIL
  587.     ENDIF
  588.   ENDFOR
  589.   IF numc=0 THEN Raise(NOCHANNEL)
  590.   IF maxrows=0 THEN Raise(NOGRAM)
  591.   IF maxrows>MAXROWS THEN Raise(LARGESONG)
  592. EXCEPT
  593.   IF exception>=GEN_ER THEN WriteF('ERROR: ')
  594.   SELECT exception
  595.     CASE NOCHANNEL;  WriteF('Atleast one channel must be defined\n')
  596.     CASE LARGESONG;  WriteF('Song too large!\n')
  597.     CASE CROSSINDEX; WriteF('No cross-symbol indexing allowed\n')
  598.     DEFAULT;         Raise(exception)         /* re-throw if unknown */
  599.   ENDSELECT
  600.   Raise(BADSTRUCTURE)        /* terminate */
  601. ENDPROC
  602.  
  603. PROC findsym(name)
  604.   DEF s:PTR TO sym
  605.   s:=symlist
  606.   WHILE s
  607.     IF StrCmp(s.name,name,ALL) THEN BRA.S continue
  608.     s:=s.next
  609.   ENDWHILE
  610.   RETURN FALSE
  611.   continue:
  612.   rewritelist(s.rptr)
  613. ENDPROC TRUE
  614.  
  615. PROC rewritelist(list:PTR TO rlist)
  616.   WHILE list
  617.     rewritesym(list)
  618.     list:=list.next
  619.   ENDWHILE
  620. ENDPROC
  621.  
  622. PROC rewritesym(rsym:PTR TO rlist)
  623.   DEF t,sl:PTR TO sym,rnd,c1,c2,ol:PTR TO optset,x,i,st:PTR TO LONG,l,n
  624.   FreeStack(); CtrlC()
  625.   t:=rsym.type
  626.   SELECT t
  627.     CASE SYM
  628.       sl:=rsym.info
  629.       IF i:=rsym.index
  630.         st:=itab[i].start
  631.         l:=itab[i].len
  632.         IF st
  633.           IF np+l>=end THEN Raise(LARGESONG)
  634.           IF sl<>itab[i].isym THEN Raise(CROSSINDEX)
  635.           l:=Shr(l,2)
  636.           IF l THEN FOR x:=1 TO l DO np[]++:=IF n:=st[]++ THEN
  637.             n AND MASK OR curglob ELSE 0
  638.         ELSE
  639.           st:=np
  640.           rewritelist(sl.rptr)
  641.           itab[i].len:=np-st
  642.           itab[i].start:=st
  643.           itab[i].isym:=sl
  644.         ENDIF
  645.       ELSE
  646.         rewritelist(sl.rptr)
  647.       ENDIF
  648.     CASE OPTION
  649.       IF Rnd(1001)<rsym.index THEN rewritelist(rsym.info)
  650.     CASE OPTSET
  651.       rnd:=Rnd(rsym.index)
  652.       c1:=c2:=0
  653.       ol:=rsym.info
  654.       WHILE ol
  655.         c2:=c1+ol.weight
  656.         IF (rnd>=c1) AND (rnd<c2) THEN rewritelist(ol.rptr)
  657.         c1:=c2
  658.         ol:=ol.next
  659.       ENDWHILE
  660.     CASE NOTE
  661.       np[]++:=cursfx OR curglob OR Shl(timings[rsym.info+-MINNOTE],16)
  662.       IF rsym.index>1 THEN FOR x:=2 TO rsym.index DO np[]++:=0
  663.       IF np>=end THEN Raise(LARGESONG)
  664.       cursfx:=0
  665.     CASE SAMPLE
  666.       cursample:=rsym.info
  667.       curglob:=Shl(cursample+1 AND $F,12) OR Shl(cursample+1 AND $F0,24)
  668.     CASE SFX
  669.       cursfx:=rsym.info
  670.   ENDSELECT
  671. ENDPROC
  672.  
  673. PROC loadsamples() HANDLE
  674.   DEF s:PTR TO sample,i,l,r,f:PTR TO LONG
  675.   s:=sdata
  676.   FOR i:=1 TO numsample
  677.     IF (l:=FileLength(s.path))<10 THEN Raise(0)
  678.     s.len:=l
  679.     s.adr:=New(l)
  680.     IF (fh:=Open(s.path,OLDFILE))=NIL THEN Raise(0)
  681.     r:=Read(fh,s.adr,l)
  682.     Close(fh)
  683.     fh:=NIL
  684.     IF r<10 THEN Raise(0)
  685.     f:=s.adr
  686.     IF f[]="FORM"
  687.       WHILE f[]++<>"BODY" DO IF s.adr+l<f THEN Raise(0)
  688.       s.len:=l+s.adr-f
  689.       s.adr:=f
  690.     ENDIF
  691.     s++
  692.   ENDFOR
  693. EXCEPT
  694.   WriteF('While processing sample "\s":\n',s.path)
  695.   Raise(READSAMPLE)
  696. ENDPROC
  697.  
  698. PROC writemodule()
  699.   DEF s,x,pnum,dat[4]:ARRAY OF LONG,nument,n,ch:PTR TO LONG,len,wl
  700.   IF (fh:=Open(outfile,NEWFILE))=NIL THEN Raise(WRITEMOD)
  701.   Write(fh,StringF(s:=String(19),'\l\s[20]',arg) BUT s,20)
  702.   FOR x:=0 TO MAXSAMPLE-1
  703.     wl:=Shr(sdata[x].len,1)
  704.     IF x>=numsample
  705.       Write(fh,[0,0,0,0,0,0,0,0],30)
  706.     ELSE
  707.       Write(fh,sdata[x].path,21)
  708.       Out(fh,0)
  709.       Write(fh,[wl,sdata[x].vol,0,1]:INT,8)  /* or [,,wl,] */
  710.     ENDIF
  711.   ENDFOR
  712.   IF (pnum:=maxrows/256)*256<>maxrows THEN INC pnum
  713.   Out(fh,pnum)
  714.   Out(fh,120)  /* 127 */
  715.   FOR x:=0 TO pnum-1 DO Out(fh,x)
  716.   FOR x:=pnum TO 127 DO Out(fh,0)
  717.   Write(fh,["M.K."],4)
  718.   nument:=pnum*64-1
  719.   FOR x:=0 TO nument
  720.     FOR n:=0 TO 3
  721.       ch:=channel[n].start
  722.       IF ch
  723.         len:=channel[n].len
  724.         IF len
  725.           dat[n]:=ch[]++
  726.           channel[n].start:=ch
  727.           channel[n].len:=len-4
  728.         ELSE
  729.           dat[n]:=0
  730.         ENDIF
  731.       ELSE
  732.         dat[n]:=0
  733.       ENDIF
  734.     ENDFOR
  735.     Write(fh,dat,16)
  736.   ENDFOR
  737.   FOR x:=0 TO numsample-1
  738.     Write(fh,sdata[x].adr,sdata[x].len)
  739.   ENDFOR
  740.   Close(fh)
  741.   fh:=NIL
  742. ENDPROC
  743.